R-Version: [Default] [64-bit] C:\Program Files\R\R-4.1.0
In folgendem Junk werden alle Tabellen aus den CSV’s eingelesen. Doku Daten: https://sorry.vse.cz/~berka/challenge/PAST/index.html (rechte Seite PKDD’99 Challenge > Data > Financial Data Description)
Der Datensatz besteht aus acht verschiedenen Tabellen, welche teils durch Keys miteinander verknüpft sind.
root_path <- "./xselling_banking_data-1/xselling_banking_data/"
accounts <- read.csv(paste0(root_path, "account.csv"), header = TRUE, sep = ";")
cards <- read.csv(paste0(root_path, "card.csv"), header = TRUE, sep = ";")
clients <- read.csv(paste0(root_path, "client.csv"), header = TRUE, sep = ";")
dispositions <- read.csv(paste0(root_path, "disp.csv"), header = TRUE, sep = ";")
districts <- read.csv(paste0(root_path, "district.csv"), sep = ";")
loans <- read.csv(paste0(root_path, "loan.csv"), header = TRUE, sep = ";")
orders <- read.csv(paste0(root_path, "order.csv"), header = TRUE, sep = ";")
transactions <- read.csv(paste0(root_path, "trans.csv"), header = TRUE, sep = ";")sample_n(accounts, 5)Die Account-Tabelle enthält vier Kolonnen: die Account-ID, die District-ID (welche auf die District-Tabelle verweist), die Frequenz, welche die Häufigkeit der Ausstellung der Abrechnungen als Kategorie besagt, und das Erstellungsdatum des Accounts. Die Frequenz kann eine von drei verschiedenen Werten annehmen.
unique(accounts$frequency)[1] "POPLATEK MESICNE" "POPLATEK PO OBRATU" "POPLATEK TYDNE"
Nachfolgend sollen die Frequenz-Werte übersetzt und das Datum in ein richtiges Format transformiert werden. Ausserdem soll die Tabelle auf fehlende Werte überprüft werden.
accounts$date <- as.Date(as.character(accounts$date), format= "%y%m%d")
accounts$frequency[accounts$frequency == "POPLATEK MESICNE"] <- "monthly"
accounts$frequency[accounts$frequency == "POPLATEK TYDNE"] <- "weekly"
accounts$frequency[accounts$frequency == "POPLATEK PO OBRATU"] <- "after_transaction"
sum(is.na(accounts))[1] 0
Es gibt also keine fehlende Werte in diesem Dataframe.
sample_n(cards, 5)Auch bei card muss das Datum umgewandelt werden, der zeitliche Teil wird ignoriert, da er immer 0 ist.
cards$issued <- as.Date(as.character(cards$issued), format= "%y%m%d")
cards$type[cards$type == "gold"] <- "classic"
cards <- filter(cards, type == "classic")
sum(is.na(cards))[1] 0
sample_n(clients, 10)In der Tabelle existiert die Spalte birth_number, welcher man auf den ersten Blick die Datumsräpresentation nicht ansieht. In der Doku wird die Struktur deutlich, sie ist für Männer YYMMDD und für Frauen YYMMDD+50DD. In Folge wird die Nummer in ihre Datumsräpresentation konvertiert und die Spalte “gender” als male/female aufgeschlüsselt. Zudem wird das Alter der clients bezogen auf das Jahr 1999 herausextrahiert, da der Datensatz aus diesem Jahr stammt. Es wird nicht year(Sys.Date()) verwendet, damit die Daten auch in Zukunft konsistent blieben.
# Months above 12 must be female
clients <- mutate(clients, gender =
ifelse(substr(birth_number, 3, 4) > 12, "female", "male"))
# Substract the 50 to get the birth month
clients <- mutate(clients, birth_month =
ifelse(as.numeric(substr(birth_number, 3, 4)) > 12,
as.numeric(substr(birth_number, 3, 4)) - 50,
as.numeric(substr(birth_number, 3, 4))))
# Transform the birth_number to a date
clients <- mutate(clients, birth_number = paste("19",
substr(birth_number, 1, 2),
str_pad(birth_month, 2,
pad = "0"),
substr(birth_number, 5, 6),
sep = "", collapse = NULL))
clients$birth_date <- as.Date(as.character(clients$birth_number),
format= "%Y%m%d")
# Remove unused columns
clients$birth_month <- NULL
clients$birth_number <- NULL
# Get the age of the clients in the year 1999 and save it in a column
get_age <- function(birth_date) {
base_year <- 99
year <- substr(birth_date, 3, 4)
result <- base_year - as.integer(year)
return(result)
}
clients <- clients %>%
mutate(age = get_age(birth_date))
sum(is.na(clients))[1] 0
accountsclientssample_n(dispositions, 5)Bei Dispositions sollen nur Owners verwendet werden, da die Analyse nur Eigentümer von Konten behandeln soll.
dispositions <- dispositions %>% filter(type == 'OWNER')
sum(is.na(dispositions))[1] 0
Bei district sind die Spaltennamen der Tabelle abhanden gekommen. Hier werden die Tabellennamen umbenannt, gemäss Doku.
districts <- rename(districts, district_id = A1, district_name = A2, region = A3,
inhabitants = A4, municipalities_inhabitants_smaller_499 = A5,
municipalities_inhabitants_500_to_1999 = A6,
municipalities_inhabitants_2000_to_9999 = A7,
municipalities_inhabitants_larger_10000 = A8, cities = A9,
urban_inhabitants_ratio = A10, average_salary = A11,
unemployment_rate_95 = A12, unemployment_rate_96 = A13,
entrepreneurs_per_1000 = A14, crimes_95 = A15,
crimes_96 = A16)
sum(is.na(districts))[1] 0
sample_n(transactions, 5)In den Transaktionen muss das Datum gemäss Format YYMMDD konvertiert werden.
# Rename k_symbol
transactions <- rename(transactions, c("characterization" = "k_symbol"))
# Change formats
transactions$date <- as.Date(as.character(transactions$date), format= "%y%m%d")
transactions$amount <- as.numeric(transactions$amount)
transactions$balance <- as.numeric(transactions$balance)
# Translate values
transactions$type[transactions$type == "PRIJEM"] <- "credit"
transactions$type[transactions$type == "VYDAJ"] <- "withdrawal"
transactions$type[transactions$type == "VYBER"] <- "withdrawal"
transactions$operation[transactions$operation == "VKLAD"] <- "cash credit"
transactions$operation[transactions$operation == "PREVOD Z UCTU"] <- "collection"
transactions$operation[transactions$operation == "VYBER"] <- "cash withdrawal"
transactions$operation[transactions$operation == " "] <- "unknown"
transactions$operation[transactions$operation == "PREVOD NA UCET"] <- "remittance"
transactions$operation[transactions$operation == "VYBER KARTOU"] <- "card withdrawal"
transactions$characterization[transactions$characterization == " "] <- "unknown"
transactions$characterization[transactions$characterization == "DUCHOD"] <- "pension"
transactions$characterization[transactions$characterization == "UROK"] <- "interest"
transactions$characterization[transactions$characterization == "SIPO"] <- "household"
transactions$characterization[transactions$characterization == "SLUZBY"] <- "payment statement"
transactions$characterization[transactions$characterization == "POJISTNE"] <- "insurance"
transactions$characterization[transactions$characterization == "SANKC. UROK"] <- "neg_interest"
transactions$characterization[transactions$characterization == "UVER"] <- "loan_pay"
sum(is.na(transactions))[1] 760931
sample_n(orders, 5)# Rename column k_symbol
orders <- rename(orders, "characterization" = "k_symbol")
# Translate column characterization
orders$characterization[orders$characterization == "SIPO"] <- "household"
orders$characterization[orders$characterization == "UVER"] <- "loan"
orders$characterization[orders$characterization == "POJISTNE"] <- "insurance"
orders$characterization[orders$characterization == "LEASING"] <- "leasing"
# Categorize NA as unknown
orders$characterization[is.na(orders$characterization)] <- "unknown"
orders$amount <- as.numeric(orders$amount)
sum(is.na(loans))[1] 0
sample_n(loans, 5)loans$date <- as.Date(as.character(loans$date), format= "%y%m%d")
loans$payments <- as.numeric(loans$payments)
loans$amount <- as.numeric(loans$amount)
# Make column status human readable
loans$status[loans$status == "A"] <- "finished_payed"
loans$status[loans$status == "B"] <- "finished_not_payed"
loans$status[loans$status == "C"] <- "running_ok"
loans$status[loans$status == "D"] <- "running_in_debt"
sum(is.na(loans))[1] 0
In diesem Abschnitt werden die verschiedenen Tabellen zusammen gesetzt. Dabei werden loan, cards und district it left join angehängt, damit fehlende Spalten nicht den Datensatz verkleinern. Die Transaktionsdaten werden hier noch nicht zusammengeführt.
# Clients mit dispositions
full <- inner_join(clients, dispositions, by = "client_id", suffix = c(".client", ".dispositions"))
sum(duplicated(full$client_id))[1] 0
# Full mit account
full <- inner_join(full, accounts, by = "account_id", suffix = c("", ".accounts"))
sum(duplicated(full$account_id))[1] 0
# Full mit loan
sum(duplicated(loans$account_id))[1] 0
full <- left_join(full, loans, by = "account_id", suffix = c("", ".loans"))
# Full mit cards
full <- left_join(full, cards, by = "disp_id", suffix = c("", ".cards"))
sum(duplicated(cards$disp_id))[1] 0
# District Informations for client
full <- left_join(full, districts, by = "district_id")
# District informations for card
full <- left_join(full, districts, by = c("district_id.accounts"="district_id"), suffix = c("", ".accounts"))
sample_n(full, 5)Jugendliche und Personen, welche während des Zeitraums des Datensatzes erst erwachsen worden sind, sollen nicht in die Auswertung einfliessen. Da sicher der Datensatz über einen Zeitraum von sechs Jahren erstreckt werden alle Clients jünger als 25 Jahre herausgefiltert.
full <- full %>% filter(age >= 25)fullAls nächstes werden alle Zeilen mit Kreditkartenkäufern von den Nicht-Käufern getrennt
has_card_function <- function(x) {
if (is.na(x)) {
return(FALSE)
} else {
return(TRUE)
}
}
# Erstelle die neue Spalte "has_card" mit der apply()-Funktion und der oben definierten Funktion
full$has_card <- sapply(full[, "card_id"], has_card_function)
full <- full %>% select(-card_id, -type.cards)
card_buyers <- full %>% filter(has_card == TRUE)
non_buyers <- full %>% filter(has_card == FALSE)Jetzt können wir noch einige Variabeln entfernen, welche keinen Einfluss auf das Modell haben sollten.
sample_n(transactions, 5)Bei den Transaktionen ist jeweils die neue Balance und der Betrag der Transaktion angegebn. Das Problem dabei ist, dass alle Beträge positiv sind, auch wenn sie eigentlich abgezogen werden.
df <- transactions
# Konvertieren Sie das 'date'-Feld in ein Datum
df$date <- as.Date(df$date)
# Sortieren Sie das Dataframe nach Nutzer und Datum
df <- df[order(df$account_id, df$date), ]
# Gruppieren Sie das Dataframe nach Nutzer
df <- group_by(df, account_id)
# Iterieren Sie über jeden Nutzer und bearbeiten Sie die Transaktionen
df <- df %>%
summarize(transactions = {
# Fügen Sie eine Spalte mit dem vorherigen Kontostand hinzu
prev_balance <- ifelse(row_number() == 1, NA, lag(balance, order_by = date))
# Berechnen Sie den Unterschied zwischen dem vorherigen Kontostand und dem aktuellen Kontostand
difference <- balance - prev_balance
# Fügen Sie eine Spalte mit der Transaktionsart hinzu
type <- "add"
type[difference < 0] <- "subtract"
# Erstellen Sie das Dataframe mit den Transaktionen für jeden Nutzer
transactions_df <- data.frame(amount, date, balance, prev_balance, difference, type)
transactions_df
}) %>%
ungroup()
transactions <- unnest(df, transactions)
# Hinzufügen des ersten amounts bei jedem Account
transactions$difference <- ifelse(is.na(transactions$difference) & is.na(transactions$prev_balance) & (transactions$amount == transactions$balance), transactions$amount, transactions$difference)
transactions$amount <- NULL
transactionsUm die Transaktions-Daten in unseren Modellen brauchen zu können, muss für jeden Kunde ein Rollup-Fenster erstellt werden. Dies fasst die Transaktionen der zwölf Monate vor dem Erhalt einer Kreditkarte zusammen (minus einen Monat Input Lag). Auf diesen Monaten werden die Transaktionen zusammengefasst.
Als erstes werden die Transaktionen von Kunden herausgefiltert, welche eine Kreditkarte haben.
account_ids <- card_buyers$account_id
buyer_transactions <- transactions[transactions$account_id %in% account_ids,]Das issued-Datum soll zu den Transaktionen hinzugefügt werden, damit diese für jeden Kunden einzeln gefiltert werden können.
buyer_transactions <- merge(buyer_transactions, full[, c("account_id", "issued")], by="account_id")Nun sollen Transaktionen so gefiltert werden, dass nur noch Transaktionen zwischen 13 Monaten und 1 Monat vor dem Issued Datum vorkommen.
filtered_df <- buyer_transactions %>%
filter(date >= as.Date(paste0(format(issued - months(13), "%Y-%m"), "-01")) &
date <= as.Date(paste0(format(issued - months(1), "%Y-%m"), "-01")) - 1)Auf diesen Daten wird eine Gruppierung anhand der account_id und des Monats gemacht werden. Die Werte in difference und balance werden zu verschiedenen Metriken zusammengefasst: Auf beiden Werten erfassen wir das Minimum, das Maximum, den Durchschnitt, den Median und die Standardabweichung. Bei der balance erfassen wir die erste und die letzte Balance des Monats und bei difference die Anzahl positive und negative differences.
summary_df <- filtered_df %>%
group_by(account_id, month = format(date, "%Y-%m")) %>%
summarise(
max_difference = max(difference),
min_difference = min(difference),
max_balance = max(balance),
min_balance = min(balance),
initial_balance = first(balance),
end_balance = last(balance),
mean_balance = mean(balance),
median_balance = median(balance),
std_balance = sd(balance),
mean_difference = mean(difference),
median_difference = median(difference),
std_difference = sd(difference),
count_positive_difference = sum(difference > 0),
count_negative_difference = sum(difference < 0)
)
summary_df <- summary_df %>%
arrange(account_id)
summary_dfJetzt haben wir für jede account_id eine Übersicht über die 12 Monate vor dem Kartenerhalt. Da es aber sein könnte, dass es Kunden gibt, welche nicht jeden Monat eine Transaktion hatten oder die Kreditkarte bereits im ersten Jahr erhalten haben, kontrollieren wir dies noch.
# Kontrolle, ob für jeden account_id 12 monate vorhanden sind
month_counts <- summary_df %>%
group_by(account_id) %>%
summarise(month_count = n_distinct(month))
# Prüfe, ob jedes account_id 12 Monate hat
month_counts <- month_counts %>% filter(month_count != 12)
month_countsNA162 Kunden haben also keine 12 kontinuierlichen Monate mit Transaktionen, bevor sie eine Karte bekommen. Wir filtern diese Kunden raus.
summary_df <- subset(summary_df, !account_id %in% month_counts$account_id)Als nächstes nummerieren wir die Monate pro account_id von 1 bis 12 durch, um danach weiter damit arbeiten zu können.
# Sortieren nach account_id und Monat
summary_df <- summary_df[order(summary_df$account_id, rev(summary_df$month)),]
# Hinzufügen der Monatsnummer
summary_df$group_id <- ave(seq_along(summary_df$account_id), summary_df$account_id, FUN = function(x) {x})
summary_df$month_number <- 12
for (i in 2:nrow(summary_df)) {
if (summary_df$account_id[i] != summary_df$account_id[i-1]) {
summary_df$month_number[i] <- 12
} else {
summary_df$month_number[i] <- summary_df$month_number[i-1] - 1
}
}
# Entferne die Spalte group_id
summary_df$group_id <- NULL
summary_df$month <- NULLNun möchten wir alle Informationen pro account_id auf einer Zeile haben. Dafür brauchen wir pivot_wider. So haben wir jede Kennzahl zwölf mal als Kolonne, jedes Mal mit der vorher erstellten Monatsnummer als Suffix.
summary_df_buyers <- summary_df %>%
group_by(account_id) %>%
pivot_wider(names_from = month_number,
values_from = c(max_difference, min_difference, max_balance, min_balance, initial_balance, end_balance, mean_balance, median_balance, std_balance, median_balance, std_balance, mean_difference, median_difference, std_difference, count_positive_difference, count_negative_difference))
summary_df_buyers <- merge(summary_df_buyers, card_buyers, by = "account_id")summary_df_buyersZu jedem Kartenkäufer soll nun ein ähnlicher Nichtkäufer gefunden werden
# Erstelle ein leeres DataFrame "similar_non_buyers"
similar_non_buyers <- data.frame()
# Iteriere über jeden Kunden im DataFrame "buyers"
for (i in 1:nrow(card_buyers)) {
# Wähle den aktuellen Kunden aus dem DataFrame "buyers"
current_buyer <- card_buyers[i, ]
# Wähle die Kunden aus dem DataFrame "non_buyers" aus, die das gleiche Geschlecht haben und möglichst gleich alt sind und möglichst in der gleichen Region wohnen
similar_non_buyers_temp <- non_buyers %>%
filter(gender == current_buyer$gender,
abs(age - current_buyer$age) <= 5,
region == current_buyer$region)
# Wähle den am besten passenden Kunden aus "similar_non_buyers_temp" aus
best_match_index <- which.min(abs(similar_non_buyers_temp$age - current_buyer$age))
best_match <- similar_non_buyers_temp[best_match_index, ]
best_match$issued <- current_buyer$issued
# damit nicht der gleiche non_buyer doppelt verwendet wird
non_buyers <- non_buyers %>% filter(client_id != best_match$client_id)
similar_non_buyers <- rbind(similar_non_buyers, best_match)
}Auch hier sollen die Transaktionen gleich wie bei den Käufern zusammengefasst werden.
account_ids <- similar_non_buyers$account_id
non_buyer_transactions <- transactions[transactions$account_id %in% account_ids,]
non_buyer_transactions <- merge(non_buyer_transactions, similar_non_buyers[, c("account_id", "issued")], by="account_id")filtered_df <- non_buyer_transactions %>%
filter(date >= as.Date(paste0(format(issued - months(13), "%Y-%m"), "-01")) &
date <= as.Date(paste0(format(issued - months(1), "%Y-%m"), "-01")) - 1)summary_df <- filtered_df %>%
group_by(account_id, month = format(date, "%Y-%m")) %>%
summarise(
max_difference = max(difference),
min_difference = min(difference),
max_balance = max(balance),
min_balance = min(balance),
initial_balance = first(balance),
end_balance = last(balance),
mean_balance = mean(balance),
median_balance = median(balance),
std_balance = sd(balance),
mean_difference = mean(difference),
median_difference = median(difference),
std_difference = sd(difference),
count_positive_difference = sum(difference > 0),
count_negative_difference = sum(difference < 0)
)
summary_df <- summary_df %>%
arrange(account_id)# Kontrolle, ob für jeden account_id 12 monate vorhanden sind
month_counts <- summary_df %>%
group_by(account_id) %>%
summarise(month_count = n_distinct(month))
# Prüfe, ob jedes account_id 12 Monate hat
month_counts <- month_counts %>% filter(month_count != 12)
month_countsNAAuch hier haben wieder einige Kunden weniger als 12 kontinuierliche Monate.
summary_df <- subset(summary_df, !account_id %in% month_counts$account_id)summary_df <- summary_df[order(summary_df$account_id, rev(summary_df$month)),]
summary_df$group_id <- ave(seq_along(summary_df$account_id), summary_df$account_id, FUN = function(x) {x})
summary_df$month_number <- 12
for (i in 2:nrow(summary_df)) {
if (summary_df$account_id[i] != summary_df$account_id[i-1]) {
summary_df$month_number[i] <- 12
} else {
summary_df$month_number[i] <- summary_df$month_number[i-1] - 1
}
}
# Entferne die Spalte group_id
summary_df$group_id <- NULL
summary_df$month <- NULLsummary_df_non_buyers <- summary_df %>%
group_by(account_id) %>%
pivot_wider(names_from = month_number,
values_from = c(max_difference, min_difference, max_balance, min_balance, initial_balance, end_balance, mean_balance, median_balance, std_balance, median_balance, std_balance, mean_difference, median_difference, std_difference, count_positive_difference, count_negative_difference))Die Transaktionsdaten werden mit den anderen Daten zusammengefügt, um pro Kunde eine Zeile in einem Dataframe zu haben.
summary_df_non_buyers <- merge(summary_df_non_buyers, similar_non_buyers, by = "account_id")merge(summary_df_non_buyers, non_buyers, by = "account_id")final_df <- rbind(summary_df_buyers, summary_df_non_buyers)Jetzt muss noch dass issued-Datum sowie weitere Variabeln entfernt werden.
# Entferne weitere unnötige Variabeln wie ID's oder Werte, welche überall gleich sind
final_df <- final_df %>% select(-client_id, -district_id, -district_id.accounts, -disp_id, -type, -loan_id, -account_id)Als Vorbereitung für die Modelle müssen wir unsere Daten zu Trainings- und Testdaten unterteilen. Wir nehmen 80% als Trainingsdaten
split_data <- function(df, test_size = 0.2) {
set.seed(27)
split <- createDataPartition(df$has_card, p = 1 - test_size, list = FALSE)
train <- df[split, ]
test <- df[-split, ]
return(list(train = train, test = test))
}Als erstes soll eine logistische Regression mit den Informationen Alter, Geschlecht, Domizilregion, Vermögen (balance-Schnitt über alle Monate) und Umsatz (difference-Schnitt über alle Monate) als Baseline Modell erstellt werden.
baseline_data <- final_df
baseline_data$mean_balance <- rowMeans(final_df[, c("mean_balance_1", "mean_balance_2", "mean_balance_3", "mean_balance_4",
"mean_balance_5", "mean_balance_6", "mean_balance_7", "mean_balance_8",
"mean_balance_9", "mean_balance_10", "mean_balance_11", "mean_balance_12")])
baseline_data$mean_difference <- rowMeans(final_df[, c("mean_difference_1", "mean_difference_2", "mean_difference_3", "mean_difference_4",
"mean_difference_5", "mean_difference_6", "mean_difference_7", "mean_difference_8",
"mean_difference_9", "mean_difference_10", "mean_difference_11", "mean_difference_12")])
baseline_data <- baseline_data[, c("age", "gender", "region", "has_card", "mean_balance", "mean_difference")]
baseline_data$has_card <- as.factor(baseline_data$has_card)Mache den Train-Test-Split auf diesen Daten
splits <- split_data(baseline_data, test_size = 0.2)
train <- splits$train
test <- splits$testTrainiere ein Regressionsmodell auf den Trainingsdaten und berechne die Predictions auf den Testdaten
# Fit the model on the training data
model <- glm(has_card ~ ., data = train, family = binomial)
# Make predictions on the test data
predictions <- predict(model, test, type = "response")Um die Modelle vergleichen zu können, rechnen wir hier die accuracy aus.
threshold <- 0.5
predictions_01 <- ifelse(predictions > threshold, 1, 0)
accuracy <- mean(test$has_card == predictions_01)
# Print the result
print(paste("Accuracy:", accuracy))[1] "Accuracy: 0.748743718592965"
final_df$district_name <- NULL
final_df$district_name.accounts <- NULLfinal_df$unemployment_rate_95 <- as.numeric(final_df$unemployment_rate_95)Warning: NAs introduced by coercion
final_df$unemployment_rate_95.accounts <- as.numeric(final_df$unemployment_rate_95.accounts)Warning: NAs introduced by coercion
final_df$crimes_95 <- as.numeric(final_df$crimes_95)Warning: NAs introduced by coercion
final_df$crimes_95.accounts <- as.numeric(final_df$crimes_95.accounts)Warning: NAs introduced by coercion
final_df <- final_df %>% select(-date.loans, -amount, -duration, -payments, -status, -issued, -inhabitants, -municipalities_inhabitants_smaller_499, -municipalities_inhabitants_500_to_1999, -municipalities_inhabitants_2000_to_9999, -municipalities_inhabitants_larger_10000, -cities, -urban_inhabitants_ratio)splits <- split_data(final_df, test_size = 0.2)
train <- splits$train
test <- splits$test# Fit the model on the training data
model <- glm(has_card ~ ., data = train, family = binomial)
# Make predictions on the test data
predictions <- predict(model, test, type = "response")
# Calculate the ROC AUC value
roc_auc <- auc(test$has_card, predictions)
# Print the result
print(paste("ROC AUC:", roc_auc))[1] "ROC AUC: 0.741742654508612"
f1 <- f1(test$has_card, predictions)
# Print the result
print(paste("F1 score:", f1))[1] "F1 score: 0"
precision <- precision(test$has_card, predictions)
# Calculate the recall
recall <- recall(test$has_card, predictions)
# Print the results
print(paste("Precision:", precision))[1] "Precision: NA"
print(paste("Recall:", recall))[1] "Recall: NA"
threshold <- 0.5
predictions_01 <- ifelse(predictions > threshold, 1, 0)
predictions_01 <- ifelse(is.na(predictions_01), 0, predictions_01)
accuracy <- mean(test$has_card == predictions_01)
# Print the result
print(paste("Accuracy:", accuracy))[1] "Accuracy: 0.71356783919598"
sum(is.na(final_df))[1] 230
final_df_without_na <- na.omit(final_df)
final_df_without_na$has_card <- as.factor(final_df_without_na$has_card)
splits <- split_data(final_df_without_na, test_size = 0.2)
train <- splits$train
test <- splits$test
model <- train(has_card ~ ., data = train, method = "glm", trControl = trainControl(method = "cv"))
# View the selected features
model$finalModel$variablesNULL
set.seed(123)
splits <- split_data(final_df, test_size = 0.2)
train <- splits$train
test <- splits$test
model <- rpart(has_card ~ ., data = train, method = "class")
# Make predictions on the test data
predictions <- predict(model, test, type = "class")
predictions <- as.factor(predictions)
test$has_card <- as.factor(test$has_card)
# Calculate the confusion matrix
confusion_matrix <- confusionMatrix(predictions, test$has_card)
# Calculate the accuracy
accuracy <- confusion_matrix$overall[1]
# Print the results
print(paste("Accuracy:", accuracy))[1] "Accuracy: 0.842105263157895"
set.seed(123)
final_df$has_card <- as.factor(final_df$has_card)
final_df <- na.omit(final_df)
# Teilen Sie den Datensatz in Trainings- und Testdaten auf
train_index <- createDataPartition(final_df$has_card, p = 0.8, list = FALSE)
train <- final_df[train_index, ]
test <- final_df[-train_index, ]
# Erstellen Sie ein Random Forest-Modell
model <- rand_forest() %>% set_mode("classification")
# Trainieren Sie das Modell mit bootstrapped resampling
model <- model %>% fit(has_card ~ ., data = train)
# Machen Sie Vorhersagen auf den Testdaten
predictions <- model %>% predict(test)
test$has_card <- as.factor(test$has_card)
# Berechnen Sie die Genauigkeit des Modells
confusion_matrix <- confusionMatrix(predictions$.pred_class, test$has_card)
# Ausgeben der Genauigkeit
print(paste("Accuracy:", confusion_matrix$overall[1]))[1] "Accuracy: 0.857894736842105"
# Legen Sie den Hyperparameter-Suchbereich fest
param_grid <- expand.grid(ntree = c(50, 100, 150),
nodesize = c(5, 10, 15))
mtry_values <- c(1, 2, 3)
splitrule_values <- c("gini", "extratrees")
min.node.size_values <- c(10, 20, 30)
# Erstellen Sie den Tuning-Parameter-Grid mit expand.grid
param_grid <- expand.grid(mtry = c(1, 5, 10),
splitrule = c("gini", "extratrees"),
min.node.size = c(5, 10, 15))
# Definieren Sie das Trainingskontrollobjekt
train_control <- trainControl(method = "cv", number = 5)
# Führen Sie die Grid Search durch
model <- train(has_card ~ ., data = train, method = "ranger",
trControl = train_control, tuneGrid = param_grid)
# Machen Sie Vorhersagen auf den Testdaten
predictions <- predict(model, test)
# Erstellen Sie eine Confusion Matrix
confusion_matrix <- confusionMatrix(predictions, test$has_card)
# Ausgeben der Genauigkeit
print(paste("Accuracy:", confusion_matrix$overall[1]))[1] "Accuracy: 0.863157894736842"